library(plyr)
library(tidyverse)
library(popdemo)
library(popbio)
Load functions.
source('R/pop01_param_poun.R')
source('R/pop03_doproj.R')
source('R/pop03_doproj_stoch.R')
Each row holds a unique set of parameters that reflect diverse recovery (conservation action) and extinction (threat) scenarios.
dt <- pop01_param_poun()
mydigits <- c(NA, NA, 1, 0, 0, 0, 2, 2, 2, 0, 0, 0, 2, 2, 0, 0 ,0, 2, 2, NA)
slice_head(dt, n = 5) |>
kableExtra::kbl(digits = mydigits) |>
kableExtra::kable_styling(full_width = F, latex_options = "hold_position")
| species | type | first_year | a1 | a2 | a3 | a4 | b1 | b2 | b3 | b4 | c1 | c2 | c3 | c4 | d1 | d2 | d3 | d4 | akey |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Podocnemis unifilis | base | 0.0 | 0 | 0 | 0 | 10.74 | 0.0 | 0.33 | 0 | 0 | 0 | 0.17 | 0.29 | 0 | 0 | 0 | 0.11 | 0.93 | poun_base_0 |
| Podocnemis unifilis | base | 0.1 | 0 | 0 | 0 | 10.74 | 0.1 | 0.33 | 0 | 0 | 0 | 0.17 | 0.29 | 0 | 0 | 0 | 0.11 | 0.93 | poun_base_0.1 |
| Podocnemis unifilis | base | 0.2 | 0 | 0 | 0 | 10.74 | 0.2 | 0.33 | 0 | 0 | 0 | 0.17 | 0.29 | 0 | 0 | 0 | 0.11 | 0.93 | poun_base_0.2 |
| Podocnemis unifilis | base | 0.3 | 0 | 0 | 0 | 10.74 | 0.3 | 0.33 | 0 | 0 | 0 | 0.17 | 0.29 | 0 | 0 | 0 | 0.11 | 0.93 | poun_base_0.3 |
| Podocnemis unifilis | base | 0.4 | 0 | 0 | 0 | 10.74 | 0.4 | 0.33 | 0 | 0 | 0 | 0.17 | 0.29 | 0 | 0 | 0 | 0.11 | 0.93 | poun_base_0.4 |
nf <- 100
dt$adultF_n <- nf
# project
dout <- plyr::ddply(dt,
c("species", "type", "first_year","akey"), .fun = pop03_doproj)
dout$arun <- 1
# Model summaries
model_sum <- dout |>
group_by(species, type, first_year, lambda, gen_time) |>
summarise(fem_t0 = max(fem_t0),
fem_min = min(fem),
fem_max = max(fem)) |>
ungroup()
lambda_n <- length(unique(model_sum$lambda)) # 50
lambda_mean <- mean(model_sum$lambda) # 0.9432
lambda_sd <- sd(model_sum$lambda) # 0.1506
lambda_min <- min(model_sum$lambda) # 0.4659
lambda_max <- max(model_sum$lambda) # 1.1539
# Stochastic
#data frame with runs for processing
#nruns <- 100 # 100 gives same pattern as 50
nruns <- 50
dt_stoch <- dt[rep(seq_len(nrow(dt)), nruns), ]
dt_stoch$arun <- rep(1:nruns, each = 50)
# Approx 7 minutes. 1 million rows.
dout_stoch <- plyr::ddply(dt_stoch,
c("arun", "species", "type", "first_year","akey"),
.fun = pop03_doproj_stoch)
table(dout_stoch$model)
# Combine data for plotting
dout_all <- dplyr::bind_rows(dout |> dplyr::select(arun, model, type, first_year,
akey, ayear,
fem),
dout_stoch |> dplyr::select(arun, model, type, first_year,
akey, ayear,
fem))
# Limit adult female number to maximum (10 x original).
dout_all[which(dout_all$fem > (nf * 10)), 'fem' ] <- (nf * 10)
# Factors in right order
dout_all$modelf <- 1
dout_all[which(dout_all$model=="Stochastic uniform") , 'modelf'] <- 2
dout_all[which(dout_all$model=="Stochastic equal") , 'modelf'] <- 3
dout_all[which(dout_all$model=="Stochastic bad x2") , 'modelf'] <- 4
dout_all[which(dout_all$model=="Stochastic bad x4") , 'modelf'] <- 5
dout_all$modelf <- as.factor(dout_all$modelf)
levels(dout_all$modelf) <- c("Deterministic", "Stochastic uniform",
"Stochastic equal", "Stochastic bad x2",
"Stochastic worst x4")
unique(dout_all$modelf)
table(dout_all$modelf)
dout_all$typef <- 1
dout_all[which(dout_all$type=="female-hunt 2.5%") , 'typef'] <- 2
dout_all[which(dout_all$type=="female-hunt 10%") , 'typef'] <- 3
dout_all[which(dout_all$type=="female-hunt 25%") , 'typef'] <- 4
dout_all[which(dout_all$type=="female-hunt 50%") , 'typef'] <- 5
dout_all$typef <- as.factor(dout_all$typef)
levels(dout_all$typef) <- c("base", "female-hunt 2.5%",
"female-hunt 10%", "female-hunt 25%",
"female-hunt 50%")
table(dout_all$typef)
# first year survival
dout_all$first_yearf <- as.factor(dout_all$first_year)
fylev <- paste("first-year\nsurvival\n", seq(0, 0.9, by = 0.1), sep = "")
levels(dout_all$first_yearf) <- fylev
saveRDS(dout_all, "inst/other/dout_all.rds")
Plot
dout_all <- readRDS("inst/other/dout_all.rds")
fig_proj <- dout_all |>
ggplot(aes(x = ayear, y = fem, colour = modelf)) +
geom_point(size=0.1, alpha=0.2) +
stat_smooth(se = FALSE) +
scale_colour_viridis_d("model") +
scale_y_continuous(limits = c(0, 1000)) +
labs(y="Reproductive females",
x="Time (years)",
) +
theme_bw() +
theme(plot.title.position = "plot") +
facet_grid(first_yearf ~ typef)
# save
png(file = "inst/other/fig_unifilis_projections.png", bg = "transparent",
type = c("cairo"),
width = 10, height = 8, units = "in", res=600)
fig_proj
invisible(dev.off())
Check plot.
Model scenarios for Podocnemis unifilis
Number of adult females along 80 km2 of river.
# Here use density values from "tracaja_dist_5km_4z_beforeafter.R" to establish "impact"
# Adult population before - after
an_b4 <- ceiling((80 * 1.0035150)) # before = 81 in 80 km2 of river
an_b4_lci <- ceiling((80 * 0.38838535))
an_b4_uci <- ceiling((80 * 2.5928949))
an_aft <- ceiling((80 * 0.1542282)) # after = 13 in 80 km2 of river
an_aft_lci <- ceiling((80 * 0.04021797))
an_aft_uci <- ceiling((80 * 0.5914359))